home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / char.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  4.8 KB  |  191 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: char.c,v 1.10 94/11/06 19:58:38 rgs Exp $
  27. *
  28. * This file implements characters.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindy.h"
  35. #include "obj.h"
  36. #include "gc.h"
  37. #include "class.h"
  38. #include "num.h"
  39. #include "bool.h"
  40. #include "error.h"
  41. #include "print.h"
  42. #include "list.h"
  43. #include "type.h"
  44. #include "def.h"
  45. #include "char.h"
  46.  
  47. #define num_characters 65536
  48.  
  49. obj_t obj_CharacterClass;
  50. obj_t obj_ByteCharacterClass;
  51. static obj_t obj_Characters[num_characters];
  52.  
  53. /* C integer to Dylan character.  Does no error checking. */
  54.  
  55. obj_t int_char(int c)
  56. {
  57.     obj_t res = obj_Characters[c];
  58.  
  59.     if (res == NULL) {
  60.     if (c < 256)
  61.         res = alloc(obj_ByteCharacterClass, sizeof(struct character));
  62.     else
  63.         res = alloc(obj_CharacterClass, sizeof(struct character));
  64.     obj_ptr(struct character *, res)->low_byte = c & 255;
  65.     obj_ptr(struct character *, res)->high_byte = (c >> 8);
  66.     obj_Characters[c] = res;
  67.     }
  68.  
  69.     return res;
  70. }
  71.  
  72.  
  73. /* Dylan routines. */
  74.  
  75. static obj_t fixnum_as_char(obj_t class, obj_t i)
  76. {
  77.     int c = fixnum_value(i);
  78.  
  79.     if (0 <= c && c < num_characters)
  80.     return int_char(c);
  81.     else {
  82.     error("Can't make a character out of %=", i);
  83.     return NULL;
  84.     }
  85. }
  86.  
  87. static obj_t fixnum_as_byte_char(obj_t class, obj_t i)
  88. {
  89.     int c = fixnum_value(i);
  90.  
  91.     if (0 <= c && c < 256)
  92.     return int_char(c);
  93.     else {
  94.     error("Can't make a byte character out of %=", i);
  95.     return NULL;
  96.     }
  97. }
  98.  
  99.  
  100. static obj_t char_as_fixnum(obj_t class, obj_t c)
  101. {
  102.     return make_fixnum(char_int(c));
  103. }
  104.  
  105. static obj_t char_less(obj_t /* <character> */ c1, obj_t /* <character> */ c2)
  106. {
  107.     if (char_int(c1) < char_int(c2))
  108.     return obj_True;
  109.     else
  110.     return obj_False;
  111. }
  112.  
  113.  
  114. /* Printing stuff. */
  115.  
  116. static void print_char(obj_t obj)
  117. {
  118.     int c = char_int(obj);
  119.  
  120.     if (c > 255)
  121.     printf("'\\{#x%x}'", c);
  122.     else if (c < ' ' || c > '~')
  123.     printf("'\\%03o'", c);
  124.     else if (c == '\'')
  125.     printf("'\\''");
  126.     else
  127.     printf("'%c'", c);
  128. }
  129.  
  130.  
  131. /* GC stuff. */
  132.  
  133. static int scav_char(struct object *ptr)
  134. {
  135.     return sizeof(struct character);
  136. }
  137.  
  138. static obj_t trans_char(obj_t c)
  139. {
  140.     return transport(c, sizeof(struct character));
  141. }
  142.  
  143. void scavenge_char_roots(void)
  144. {
  145.     int i;
  146.  
  147.     scavenge(&obj_CharacterClass);
  148.     scavenge(&obj_ByteCharacterClass);
  149.  
  150.     for (i = 0; i < num_characters; i++)
  151.     if (obj_Characters[i] != NULL)
  152.         scavenge(obj_Characters + i);
  153. }
  154.  
  155.  
  156. /* Init stuff. */
  157.  
  158. void make_char_classes()
  159. {
  160.     obj_CharacterClass = make_builtin_class(scav_char, trans_char);
  161.     obj_ByteCharacterClass = make_builtin_class(scav_char, trans_char);
  162.     /* Since characters and byte characters actually have identical 
  163.        C structures, they can use the same functions. */
  164. }
  165.  
  166. void init_char_classes()
  167. {
  168.     init_builtin_class(obj_CharacterClass, "<character>",
  169.                obj_ObjectClass, NULL);
  170.     def_printer(obj_CharacterClass, print_char);
  171.        /* This will also work for byte characters */
  172.     init_builtin_class(obj_ByteCharacterClass, "<byte-character>",
  173.                obj_CharacterClass, NULL);
  174. }
  175.  
  176. void init_char_functions()
  177. {
  178.     define_method("as", list2(singleton(obj_CharacterClass), obj_FixnumClass),
  179.           FALSE, obj_False, FALSE, obj_CharacterClass, fixnum_as_char);
  180.     define_method("as",
  181.           list2(singleton(obj_ByteCharacterClass), obj_FixnumClass),
  182.           FALSE, obj_False, FALSE, obj_ByteCharacterClass, 
  183.           fixnum_as_byte_char);
  184.     define_method("as", list2(singleton(obj_IntegerClass), obj_CharacterClass),
  185.           FALSE, obj_False, FALSE, obj_FixnumClass, char_as_fixnum);
  186.     define_method("as", list2(singleton(obj_FixnumClass), obj_CharacterClass),
  187.           FALSE, obj_False, FALSE, obj_FixnumClass, char_as_fixnum);
  188.     define_method("<", list2(obj_CharacterClass, obj_CharacterClass),
  189.           FALSE, obj_False, FALSE, obj_BooleanClass, char_less);
  190. }
  191.